home *** CD-ROM | disk | FTP | other *** search
/ Tricks of the Mac Game Programming Gurus / TricksOfTheMacGameProgrammingGurus.iso / More Source / Pascal / Book Demos in Pascal / KeyConfig / Preferences.p < prev   
Text File  |  1995-04-04  |  4KB  |  141 lines
  1.   {Preferences file handling}
  2.  
  3. {This is a stripped-down preference file handling unit. It assumes that you always want your}
  4. {preference file in the Preferences folder, and use resources for storing the information.}
  5. {This file works with System 7 only!}
  6.  
  7. unit Preferences;
  8.  
  9. interface
  10.     uses
  11. {$ifc UNDEFINED THINK_PASCAL}
  12.         Types, QuickDraw, Events, Windows, Dialogs, Fonts, DiskInit, TextEdit, Traps, Memory, SegLoad, {}
  13.         Scrap, ToolUtils, OSUtils, Menus, Resources, StandardFile, GestaltEqu, Files, Errors, 
  14. {$endc}
  15.         Folders;
  16.  
  17. {Open the pref file, create if needed. Return appFile and prefFile.}
  18. {Returns true if a new prefFile was created, which indicates that we should create new resources or copy from the app.}
  19.     function SetPrefFile (prefsFileName: Str255; prefCreator, prefType: OSType; var appFile, prefFile: integer): Boolean;
  20.  
  21. {Copy a resource from one file to another. Useful when SetPrefFile returns true!}
  22.     function CopyResource (fromFile, toFile: integer; theResType: ResType; id: integer): OSErr;
  23.  
  24. implementation
  25.  
  26. { 1) Find the Preferences folder}
  27. { 2) Check if the prefs file already exists. If it does, open it and exit. }
  28. { 3) Create the prefs file and open it.}
  29.  
  30.     function SetPrefFile (prefsFileName: Str255; prefCreator, prefType: OSType; var appFile, prefFile: integer): Boolean;
  31.         var
  32.             err: OSErr;
  33.             prefsFolder: Integer;
  34.             h: Handle;
  35.             s: Str255;
  36.             dirID: Longint;
  37.             vRefNum: integer;
  38.             spec: FSSpec;
  39.     begin
  40.         appFile := CurResFile; {spara programmerts resursfilreferens}
  41.         prefFile := 0;
  42.         SetPrefFile := false;
  43. { 1) find the Preference folder}
  44.         err := FindFolder(kOnSystemDisk, kPreferencesFolderType, true, vRefNum, dirID);
  45. {Make a file spec to the pref folder}
  46.         err := FSMakeFSSpec(vRefNum, dirID, prefsFileName, spec);
  47.  
  48. { 2) Check if a prefs file exists. If it does, open it and go to 5. }
  49.         prefFile := FSpOpenResFile(spec, fsRdWrPerm);
  50.         if ResError = noErr then
  51.             begin
  52.             end
  53.         else
  54.             begin
  55.                 prefFile := 0;
  56.  
  57. { 3) Create prefs file and open it.}
  58. {Create the file}
  59.                 err := FSpCreate(spec, prefCreator, prefType, 0); {smRoman = 0}
  60.                 if err = noErr then
  61.                     begin
  62. {Make a resource fork for it}
  63.                         FSpCreateResFile(spec, prefCreator, prefType, 0); {smRoman = 0}
  64.                         if ResError <> noErr then
  65.                             begin
  66. {Error: Couldn't create resource fork}
  67.                             end
  68.                         else
  69. {Open it}
  70.                             prefFile := FSpOpenResFile(spec, fsRdWrPerm);
  71.  
  72.                         if ResError = noErr then
  73.                             SetPrefFile := true; {new pref file!}
  74.                     end {Create succeeded}
  75.                 else
  76.                     begin
  77. {Error: Failed to create prefsfile}
  78.                     end;
  79.             end; {No prefs file existed}
  80.     end; {SetPrefFile}
  81.  
  82.  
  83. {Copy a resource:}
  84.     function CopyResource (fromFile, toFile: integer; theResType: ResType; id: integer): OSErr;
  85.         var
  86.             oldResFile: integer;
  87.             res, rescopy: Handle;
  88.             wasLoaded: Boolean;
  89.             theID: integer;
  90.             theType: ResType;
  91.             theName: Str255;
  92.         procedure Barf;
  93.         begin
  94.             CopyResource := ResError;
  95.             UseResFile(oldResFile); {set back to the previous resource file}
  96.             exit(CopyResource);
  97.         end;
  98.         procedure CheckError;
  99.         begin
  100.             if ResError <> noErr then
  101.                 Barf;
  102.         end; {CheckError}
  103.     begin
  104.         oldResFile := CurResFile;
  105.         UseResFile(fromFile);
  106.         CheckError;
  107.  
  108.         SetResLoad(false);
  109.         res := Get1Resource(theResType, id);
  110. {Don't CheckError before doing SetResLoad(true)!!!}
  111.         SetResLoad(true);
  112.         CheckError;
  113.         if res <> nil then
  114.             begin
  115.                 wasLoaded := res^ = nil;
  116.                 LoadResource(res);
  117.                 CheckError;
  118.                 UseResFile(toFile);
  119.                 CheckError;
  120.                 GetResInfo(res, theID, theType, theName);
  121.                 CheckError;
  122.                 rescopy := res;
  123.                 if HandToHand(rescopy) <> noErr then
  124.                     Barf; {i stället för DetachResource(res);}
  125.                 CheckError;
  126.                 AddResource(rescopy, theResType, id, theName);
  127.                 CheckError;
  128.                 ReleaseResource(rescopy);
  129.                 if not wasLoaded then
  130.                     ReleaseResource(res); {If it wasn't loaded before, it shouldn't be afterwards.}
  131.                 CheckError;
  132.                 CopyResource := noErr;
  133.             end
  134.         else
  135.             begin
  136.                 CopyResource := resNotFound;
  137.             end;
  138.         UseResFile(oldResFile);
  139.     end; {CopyResource}
  140.  
  141. end.